&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI adm2
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW


/* Temp-Table and Buffer definitions                                    */
DEFINE TEMP-TABLE ab_unmap
       FIELD bt-connect AS CHARACTER FORMAT "X(256)":U 
       FIELD idwlogin AS CHARACTER FORMAT "X(256)":U 
       FIELD idwpassword AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-cli AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-clienr AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-crecpt AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-newcli AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-oubli AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-pascli AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-passwd AS CHARACTER FORMAT "X(256)":U 
       FIELD lab-txtenreg AS CHARACTER FORMAT "X(256)":U 
       FIELD par-prog AS CHARACTER FORMAT "X(256)":U 
       FIELD pasclient AS LOGICAL  INITIAL no
       FIELD prog_suivant AS CHARACTER FORMAT "X(256)":U .



&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS w-html 
/*------------------------------------------------------------------------

  File: 

  Description: 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

  Created: 

------------------------------------------------------------------------*/
/*           This .W file was created with AppBuilder.                  */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

/* Preprocessor Definitions ---                                         */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEF NEW SHARED VAR a-lang          AS    INTEGER                   NO-UNDO.
DEF            VAR i               AS    INTEGER                   NO-UNDO.
DEF            VAR j               AS    INTEGER                   NO-UNDO.
DEF            VAR nomprg          AS    CHARACTER                 NO-UNDO.
DEF            VAR lab-bouton      AS    CHARACTER EXTENT 5        NO-UNDO.
DEF            VAR action          AS    CHARACTER                 NO-UNDO.
DEF            VAR LoginID         AS    CHAR                      NO-UNDO.
DEF            VAR tmp-ID          AS    CHAR                      NO-UNDO.
DEF            VAR suPWD           AS    CHAR                      NO-UNDO.
DEF            VAR int-ID          AS    INTEGER                   NO-UNDO.

DEF            VAR buf-nocli       LIKE doce.noadrf                NO-UNDO.
DEF            VAR buf-csmt        LIKE doce.csmtf                 NO-UNDO.
DEF            VAR buf-prefix      LIKE doce.prefix                NO-UNDO.
DEF            VAR buf-nodoc       LIKE doce.nodoc                 NO-UNDO.
DEF            VAR cde-prefix      LIKE doce.prefix                NO-UNDO.

DEF            VAR tmp-nocli       LIKE doce.noadrf                NO-UNDO.
DEF            VAR tmp-csmt        LIKE doce.csmtf                 NO-UNDO.

DEF            VAR flag-login      AS   LOGICAL                    NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Web-Object
&Scoped-define DB-AWARE no

&Scoped-define WEB-FILE ident.htm

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Web-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS ab_unmap.bt-connect ab_unmap.lab-clienr ~
ab_unmap.lab-crecpt ab_unmap.lab-newcli ab_unmap.lab-txtenreg ~
ab_unmap.idwlogin ab_unmap.idwpassword ab_unmap.lab-oubli ab_unmap.par-prog ~
ab_unmap.prog_suivant ab_unmap.pasclient ab_unmap.lab-pascli ~
ab_unmap.lab-cli ab_unmap.lab-passwd 
&Scoped-Define DISPLAYED-OBJECTS ab_unmap.bt-connect ab_unmap.lab-clienr ~
ab_unmap.lab-crecpt ab_unmap.lab-newcli ab_unmap.lab-txtenreg ~
ab_unmap.idwlogin ab_unmap.idwpassword ab_unmap.lab-oubli ab_unmap.par-prog ~
ab_unmap.prog_suivant ab_unmap.pasclient ab_unmap.lab-pascli ~
ab_unmap.lab-cli ab_unmap.lab-passwd 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */


/* Definitions of the field level widgets                               */

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Web-Frame
     ab_unmap.bt-connect AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-clienr AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-crecpt AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-newcli AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-txtenreg AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.idwlogin AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.idwpassword AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-oubli AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.par-prog AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.prog_suivant AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.pasclient AT ROW 1 COL 1 HELP
          ""
          LABEL "pasclient"
          VIEW-AS TOGGLE-BOX
          SIZE 20 BY 1
     ab_unmap.lab-pascli AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-cli AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
     ab_unmap.lab-passwd AT ROW 1 COL 1 HELP
          "" NO-LABEL FORMAT "X(256)":U
          VIEW-AS FILL-IN 
          SIZE 20 BY 1
    WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS 
         AT COL 1 ROW 1
         SIZE 57.63 BY 14.13.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Web-Object
   Allow: Query
   Frames: 1
   Add Fields to: Neither
   Editing: Special-Events-Only
   Events: web.output,web.input
   Other Settings: COMPILE
   Temp-Tables and Buffers:
      TABLE: ab_unmap W "?" ?  
      ADDITIONAL-FIELDS:
          FIELD bt-connect AS CHARACTER FORMAT "X(256)":U 
          FIELD idwlogin AS CHARACTER FORMAT "X(256)":U 
          FIELD idwpassword AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-cli AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-clienr AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-crecpt AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-newcli AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-oubli AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-pascli AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-passwd AS CHARACTER FORMAT "X(256)":U 
          FIELD lab-txtenreg AS CHARACTER FORMAT "X(256)":U 
          FIELD par-prog AS CHARACTER FORMAT "X(256)":U 
          FIELD pasclient AS LOGICAL  INITIAL no
          FIELD prog_suivant AS CHARACTER FORMAT "X(256)":U 
      END-FIELDS.
   END-TABLES.
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW w-html ASSIGN
         HEIGHT             = 14.13
         WIDTH              = 57.63.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB w-html 
/* *********************** Included-Libraries ************************* */

{src/web2/html-map.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME




/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW w-html
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME Web-Frame
   FRAME-NAME UNDERLINE                                                 */
/* SETTINGS FOR FILL-IN ab_unmap.bt-connect IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.idwlogin IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.idwpassword IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-cli IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-clienr IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-crecpt IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-newcli IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-oubli IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-pascli IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-passwd IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.lab-txtenreg IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR FILL-IN ab_unmap.par-prog IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* SETTINGS FOR TOGGLE-BOX ab_unmap.pasclient IN FRAME Web-Frame
   EXP-LABEL EXP-FORMAT EXP-HELP                                        */
/* SETTINGS FOR FILL-IN ab_unmap.prog_suivant IN FRAME Web-Frame
   ALIGN-L EXP-LABEL EXP-FORMAT EXP-HELP                                */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME ab_unmap.bt-connect
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.bt-connect w-html WEB.output
PROCEDURE ab_unmap.bt-connect.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     FIND erreur WHERE erreur.noerr = 101173
                   AND erreur.lang  = a-lang NO-LOCK NO-ERROR.

     {&out} "<input type=~"submit~" value=~"".
     IF AVAILABLE erreur AND erreur.libel <> "" THEN {&out} ENTRY(1,erreur.libel).
     {&out} "~" name=~"B1~" />".
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-cli
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-cli w-html WEB.output
PROCEDURE ab_unmap.lab-cli.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
      RUN aff_label(101134).  
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-clienr
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-clienr w-html WEB.output
PROCEDURE ab_unmap.lab-clienr.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN aff_label(101179).
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-crecpt
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-crecpt w-html WEB.output
PROCEDURE ab_unmap.lab-crecpt.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN aff_label(101181).
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-newcli
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-newcli w-html WEB.output
PROCEDURE ab_unmap.lab-newcli.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN aff_label(101182).
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-oubli
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-oubli w-html web.output
PROCEDURE ab_unmap.lab-oubli.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
/*      RUN aff_label(101162).  */
     {&out} "".
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-pascli
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-pascli w-html WEB.output
PROCEDURE ab_unmap.lab-pascli.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
     RUN aff_label(101070).  
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-passwd
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-passwd w-html WEB.output
PROCEDURE ab_unmap.lab-passwd.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
      RUN aff_label(101017).  
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.lab-txtenreg
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.lab-txtenreg w-html WEB.output
PROCEDURE ab_unmap.lab-txtenreg.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
      RUN aff_label(101180).
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ab_unmap.prog_suivant
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ab_unmap.prog_suivant w-html web.output
PROCEDURE ab_unmap.prog_suivant.output .
/*------------------------------------------------------------------------------
  Purpose:     Output the value of the field to the WEB stream
               in place of the HTML field definition.
  Parameters:  p-field-defn
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p-field-defn AS CHARACTER NO-UNDO.

  DEF VAR flag-trouve   AS      LOGICAL             NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:
     IF REQUEST_METHOD = "POST":U  AND flag-login THEN DO:
        {&out} "" SKIP
               "".
        IF buf-nocli <> 0 THEN DO:
           IF ab_unmap.par-prog = "abonnement" THEN DO:
              FOR EACH hist WHERE hist.prov  = "ADRA"
                              AND hist.nosoc = 1
                              AND hist.clef  = STRING(buf-nocli,"999999") + STRING(buf-csmt,"9")
                              NO-LOCK BREAK BY hist.nohist
                                            BY hist.nolig:
                  IF FIRST-OF(hist.nohist) THEN DO:

                     IF hist.nohist < 100 AND
                       (hist.code4 <> "" OR hist.code3 = "3") THEN NEXT. /* seulement abo en cours */
                     flag-trouve = TRUE.
                     LEAVE.
                  END.
              END.

              IF NOT flag-trouve THEN
                 FOR EACH hist WHERE hist.prov  = "ADRA"
                              AND hist.nosoc = 1
                              AND hist.code1 = "5"
                              AND hist.nohist < 100
                              AND INTEGER(TRIM(SUBSTRING(hist.libel,44,8))) = buf-nocli
                              NO-LOCK BREAK BY hist.clef
                                            BY hist.nohist
                                            BY hist.nolig:

                  IF FIRST-OF(hist.nohist) THEN DO:

                     IF hist.nohist < 100 AND
                       (hist.code4 <> "" OR hist.code3 = "3") THEN NEXT. /* seulement abo en cours */
                     flag-trouve = TRUE.
                     LEAVE.
                  END.
              END.
              IF flag-trouve THEN 
                                IF a-lang = 1 THEN {&out} "renew_abo_select_de|".
                                ELSE {&out} "renew_abo_select_fr|128|".
              ELSE
                                IF a-lang = 1 THEN {&out} "abo_new_de|".
                                ELSE {&out} "abo_new_fr|130|".
           END.
           ELSE IF a-lang = 1 THEN {&out} "commande_envoi_de|".
                ELSE {&out} "commande_envoi_fr|128|".

        END.
        ELSE IF ab_unmap.par-prog = "abonnement" THEN 
                IF a-lang = 1 THEN {&out} "create_cpt_de|".
                ELSE {&out} "create_cpt_fr|139|".
             ELSE IF a-lang = 1 THEN {&out} "create_cpt_de|".
                 ELSE {&out} "create_cpt_fr|139|".
        {&out} "" SKIP.
     END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK w-html 


/* ************************  Main Code Block  ************************* */

/* Standard Main Block that runs adm-create-objects, initializeObject 
 * and process-web-request.
 * The bulk of the web processing is in the Procedure process-web-request
 * elsewhere in this Web object.
 */
{src/web2/template/hmapmain.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects w-html  _ADM-CREATE-OBJECTS
PROCEDURE adm-create-objects :
/*------------------------------------------------------------------------------
  Purpose:     Create handles for all SmartObjects used in this procedure.
               After SmartObjects are initialized, then SmartLinks are added.
  Parameters:  <none>
------------------------------------------------------------------------------*/

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE aff_label w-html 
PROCEDURE aff_label :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEF INPUT PARAMETER num  AS INTEGER NO-UNDO.

  FIND erreur WHERE erreur.noerr = num
                AND erreur.lang  = a-lang NO-LOCK NO-ERROR.

  IF AVAILABLE erreur AND erreur.libel <> "" THEN {&out} TRIM(erreur.libel).
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE calcul_mtligne w-html 
PROCEDURE calcul_mtligne :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF            VAR buf-pumb         LIKE docld.punite NO-UNDO.
DEF            VAR buf-punite       LIKE docld.punite NO-UNDO.
DEF            VAR buf-unitp        LIKE docld.unitp  NO-UNDO.
DEF            VAR buf-nocpt        LIKE docld.nocpt  NO-UNDO.
DEF            VAR buf-taxi         LIKE docld.taxi   NO-UNDO.

{calcul_ligne.i}

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE decode_tag w-html 
PROCEDURE decode_tag :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF INPUT  PARAMETER ligne    AS CHARACTER           NO-UNDO.
DEF INPUT  PARAMETER ancre    AS CHARACTER           NO-UNDO.
DEF OUTPUT PARAMETER lst-tag  AS CHARACTER           NO-UNDO.

DEF VAR i              AS INTEGER           NO-UNDO.
DEF VAR j              AS INTEGER           NO-UNDO.
DEF VAR pos            AS INTEGER           NO-UNDO.
DEF VAR tag            AS CHARACTER         NO-UNDO.

REPEAT:
   i = INDEX(ligne,"<!--").
   j = IF INDEX(ligne,"-->") <> 0 THEN INDEX(ligne,"-->") + 2 ELSE LENGTH(ligne).
   IF i = 0 THEN LEAVE.
   tag = SUBSTRING(ligne,i,j - i + 1).
   pos = INDEX(tag,"<!--WSTAG").
   IF pos <> 0 THEN DO:
      pos = INDEX(tag,ancre).
      IF pos <> 0 AND LOOKUP(tag,lst-tag) = 0 THEN lst-tag = lst-tag + "," + tag.
   END.
   ligne = SUBSTRING(ligne,j + 1).
END.
lst-tag = SUBSTRING(lst-tag,2).

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE htmOffsets w-html  _WEB-HTM-OFFSETS
PROCEDURE htmOffsets :
/*------------------------------------------------------------------------------
  Purpose:     Runs procedure to associate each HTML field with its
               corresponding widget name and handle.
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  RUN readOffsets ("{&WEB-FILE}":U).
  RUN htmAssociate
    ("bt-connect":U,"ab_unmap.bt-connect":U,ab_unmap.bt-connect:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("idwlogin":U,"ab_unmap.idwlogin":U,ab_unmap.idwlogin:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("idwpassword":U,"ab_unmap.idwpassword":U,ab_unmap.idwpassword:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-cli":U,"ab_unmap.lab-cli":U,ab_unmap.lab-cli:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-clienr":U,"ab_unmap.lab-clienr":U,ab_unmap.lab-clienr:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-crecpt":U,"ab_unmap.lab-crecpt":U,ab_unmap.lab-crecpt:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-newcli":U,"ab_unmap.lab-newcli":U,ab_unmap.lab-newcli:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-oubli":U,"ab_unmap.lab-oubli":U,ab_unmap.lab-oubli:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-pascli":U,"ab_unmap.lab-pascli":U,ab_unmap.lab-pascli:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-passwd":U,"ab_unmap.lab-passwd":U,ab_unmap.lab-passwd:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("lab-txtenreg":U,"ab_unmap.lab-txtenreg":U,ab_unmap.lab-txtenreg:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("par-prog":U,"ab_unmap.par-prog":U,ab_unmap.par-prog:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("pasclient":U,"ab_unmap.pasclient":U,ab_unmap.pasclient:HANDLE IN FRAME {&FRAME-NAME}).
  RUN htmAssociate
    ("prog_suivant":U,"ab_unmap.prog_suivant":U,ab_unmap.prog_suivant:HANDLE IN FRAME {&FRAME-NAME}).
END PROCEDURE.


/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE modification_document w-html 
PROCEDURE modification_document :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF            VAR i             AS   INTEGER             NO-UNDO.
DEF            VAR j             AS   INTEGER             NO-UNDO.
DEF            VAR buf-qte       AS   INTEGER             NO-UNDO.
DEF            VAR buf-ref       AS   CHARACTER           NO-UNDO.
DEF            VAR buf-art       AS   CHARACTER           NO-UNDO.
DEF            VAR flag-monnaie  AS LOGICAL               NO-UNDO.

DO WITH FRAME {&FRAME-NAME}:

   FIND doce WHERE doce.nosoc = 1
               AND doce.typdoc = "PA"
               AND doce.prefix = buf-prefix
               AND doce.nodoc  = buf-nodoc NO-ERROR.

   IF NOT AVAILABLE doce THEN RETURN.
   IF doce.noadrf = buf-nocli THEN RETURN.

   ASSIGN doce.noadrl = buf-nocli
          doce.noadrf = buf-nocli.

   FIND adrd WHERE adrd.nosoc = doce.nosoc
               AND adrd.noadr = doce.noadrl
               AND adrd.csmt  = doce.csmtl NO-LOCK NO-ERROR.

   ASSIGN doce.totme  = 0
          doce.totmtn = 0
          doce.totmb  = 0
          doce.totqte = 0
          flag-monnaie = TRUE.

   ASSIGN doce.taux   = adrd.codicha
          doce.codmon = adrd.codmon.

   FIND FIRST mon WHERE mon.nosoc  = doce.nosoc
                    AND mon.codmon = doce.codmon
                    AND mon.boucl  = ""
                    AND mon.datc  <= doce.datdoc NO-LOCK NO-ERROR.
   IF AVAILABLE mon THEN ASSIGN doce.cours = mon.cours
                                doce.unit  = mon.unit.
   ELSE ASSIGN doce.cours = 1
               doce.unit  = 1.
   
   FOR EACH docld WHERE docld.nosoc  = doce.nosoc
                    AND docld.typdoc = doce.typdoc
                    AND docld.prefix = doce.prefix
                    AND docld.nodoc  = doce.nodoc
                    AND docld.ref   <> "":

       RUN calcul_mtligne.
   END.
END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE outputHeader w-html 
PROCEDURE outputHeader :
/*------------------------------------------------------------------------
  Purpose:     Output the MIME header, and any "cookie" information needed 
               by this procedure.  
  Parameters:  <none>
  Notes:       In the event that this Web object is state-aware, this is 
               a good place to set the WebState and WebTimeout attributes.
------------------------------------------------------------------------*/

  /* To make this a state-aware Web object, pass in the timeout period
   * (in minutes) before running outputContentType.  If you supply a 
   * timeout period greater than 0, the Web object becomes state-aware 
   * and the following happens:
   *
   *   - 4GL variables webState and webTimeout are set
   *   - a cookie is created for the broker to id the client on the return trip
   *   - a cookie is created to id the correct procedure on the return trip
   *
   * If you supply a timeout period less than 1, the following happens:
   *
   *   - 4GL variables webState and webTimeout are set to an empty string
   *   - a cookie is killed for the broker to id the client on the return trip
   *   - a cookie is killed to id the correct procedure on the return trip
   *
   * For example, set the timeout period to 5 minutes.
   *
   *   setWebState (5.0).
   */
    
  /* Output additional cookie information here before running outputContentType.
   *   For more information about the Netscape Cookie Specification, see
   *   http://home.netscape.com/newsref/std/cookie_spec.html  
   *   
   *   Name         - name of the cookie
   *   Value        - value of the cookie
   *   Expires date - Date to expire (optional). See TODAY function.
   *   Expires time - Time to expire (optional). See TIME function.
   *   Path         - Override default URL path (optional)
   *   Domain       - Override default domain (optional)
   *   Secure       - "secure" or unknown (optional)
   * 
   *   The following example sets custNum=23 and expires tomorrow at (about)
   *   the same time but only for secure (https) connections.
   *      
   *   RUN SetCookie IN web-utilities-hdl 
   *     ("custNum":U, "23":U, TODAY + 1, TIME, ?, ?, "secure":U).
   */ 
  output-content-type ("text/html":U).
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-web-request w-html 
PROCEDURE process-web-request :
/*------------------------------------------------------------------------
  Purpose:     Process the web request.
  Notes:       
------------------------------------------------------------------------*/
       /* STEP 0 -
   * Output the MIME header and set up the object as state-less or state-aware. 
   * This is required if any HTML is to be returned to the browser. 
   *
   * NOTE: Move 'RUN outputHeader.' to the GET section below if you are going
   * to simulate another Web request by running a Web Object from this
   * procedure.  Running outputHeader precludes setting any additional cookie
   * information.
   */ 
  
  a-lang = INTEGER(get-field("lang")).
  IF a-lang = 0 THEN a-lang = 2.

  {client.i}

  IF get-field("pasclient") = "ON" THEN flag-login = TRUE.
  ELSE IF get-field("idwlogin") <> "" THEN DO:

          FIND parmt WHERE parmt.nosoc = 1
                       AND parmt.nomuti = ""
                       AND parmt.nompar = "PWDWEB" NO-LOCK NO-ERROR.
          IF AVAILABLE parmt THEN suPWD = parmt.valpar. 
          ELSE suPWD = ?.

          tmp-id = get-field("idwlogin").
          int-id = INTEGER(tmp-id) NO-ERROR.

          ASSIGN tmp-nocli = ?
                 tmp-csmt  = ?.

          IF INDEX(tmp-id,"@") <> 0 THEN DO:
             FOR EACH adra WHERE adra.nosoc = 1
                             AND adra.mail  = tmp-id NO-LOCK:
                 IF adra.pwdweb <> ""                   AND
                   (get-field("idwpassword") = adra.pwdweb OR
                    get-field("idwpassword") = suPWD)      THEN DO:
                    ASSIGN tmp-nocli = adra.noadr
                           tmp-csmt  = adra.csmt.
                    LEAVE.
                 END.
             END.
          END.
          ELSE IF int-id <> ? THEN DO: 
                  LoginID = get-field("idwlogin") + "/0".
                  ASSIGN tmp-nocli = INTEGER(ENTRY(1,LoginID,"/")) NO-ERROR.
                         tmp-csmt  = INTEGER(ENTRY(2,LoginID,"/")) NO-ERROR.
               END.

          IF tmp-nocli <> ? THEN DO:
             IF get-field("idwpassword") = suPWD THEN DO: 

                ASSIGN websession.clef    = STRING(tmp-nocli)
                       websession.valeur2 = "TEL".

                ASSIGN buf-nocli  = tmp-nocli
                       buf-csmt   = tmp-csmt
                       flag-login = TRUE.
             END.
             ELSE DO:
                FIND adra WHERE adra.nosoc = 1
                            AND adra.noadr = tmp-nocli
                            AND adra.csmt  = tmp-csmt NO-LOCK NO-ERROR.

                IF AVAILABLE adra                      AND
                   adra.pwdweb <> ""                   AND
                   get-field("idwpassword") = adra.pwdweb THEN DO:
                   ASSIGN websession.clef    = STRING(tmp-nocli)
                          websession.valeur2 = "WEB".

                   ASSIGN buf-nocli  = tmp-nocli
                          buf-csmt   = tmp-csmt
                          flag-login = TRUE.
                END.
             END.

             IF buf-nodoc <> 0 THEN RUN modification_document.

          END.
       END.

  RUN outputHeader.

  /* Describe whether to receive FORM input for all the fields.  For example,
   * check particular input fields (using GetField in web-utilities-hdl). 
   * Here we look at REQUEST_METHOD. 
   */
  IF REQUEST_METHOD = "POST":U THEN DO:
    /* STEP 1 -
     * Copy HTML input field values to the Progress form buffer. */
    RUN inputFields.

    /* STEP 2 -
     * Open the database or SDO query and and fetch the first record. */
    RUN findRecords.

    DO WITH FRAME {&FRAME-NAME}:
       ab_unmap.par-prog = get-field("par-prog").
       FIND erreur WHERE erreur.noerr = 101001
                     AND erreur.lang  = a-lang NO-LOCK NO-ERROR.
       lab-bouton[2] = ENTRY(1,erreur.libel).

       action  = get-field("bouton").
       IF action = "" THEN action = lab-bouton[1].
    END.

    /* STEP 3 -
     * AssignFields will save the data in the frame.
     * (it automatically upgrades the lock to exclusive while doing the update)
     *
     *  If a new record needs to be created set AddMode to true before
        running assignFields.
     *     setAddMode(TRUE).
     * RUN assignFields. */

    /* STEP 4 -
     * Decide what HTML to return to the user. Choose STEP 4.1 to simulate
     * another Web request -OR- STEP 4.2 to return the original form (the
     * default action).
     *
     * STEP 4.1 -
     * To simulate another Web request, change the REQUEST_METHOD to GET
     * and RUN the Web object here.  For example,
     *
     *  ASSIGN REQUEST_METHOD = "GET":U.
     *  RUN run-web-object IN web-utilities-hdl ("myobject.w":U).
     */

    /* STEP 4.2 -
     * To return the form again, set data values, display them, and output
     * them to the WEB stream.
     *
     * STEP 4.2a -
     * Set any values that need to be set, then display them. */
    RUN displayFields.

    /* STEP 4.2b -
     * Enable objects that should be enabled. */
    RUN enableFields.

    /* STEP 4.2c -
     * OUTPUT the Progress form buffer to the WEB stream. */
    RUN outputFields.

  END. /* Form has been submitted. */

  /* REQUEST-METHOD = GET */
  ELSE DO:
    /* This is the first time that the form has been called. Just return the
     * form.  Move 'RUN outputHeader.' here if you are going to simulate
     * another Web request. */

/*     RUN outputHeader.  */

    /* STEP 1 -
     * Open the database or SDO query and and fetch the first record. */
    RUN findRecords.

    ab_unmap.par-prog = get-field("par-prog").

    /* Return the form again. Set data values, display them, and output them
     * to the WEB stream.
     *
     * STEP 2a -
     * Set any values that need to be set, then display them. */
    RUN displayFields.

    /* STEP 2b -
     * Enable objects that should be enabled. */
    RUN enableFields.


    DO WITH FRAME {&FRAME-NAME}:
        pasclient:CHECKED    = FALSE.
    END.

    /* STEP 2c -
     * OUTPUT the Progress from buffer to the WEB stream. */
    RUN outputFields.

  END.
  
  /* Show error messages. */
  IF AnyMessage() THEN 
  DO:
     /* ShowDataMessage may return a Progress column name. This means you
      * can use the function as a parameter to HTMLSetFocus instead of 
      * calling it directly.  The first parameter is the form name.   
      *
      * HTMLSetFocus("document.DetailForm",ShowDataMessages()). */
     ShowDataMessages().
  END.
 
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remplace_tag w-html 
PROCEDURE remplace_tag :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DEF INPUT        PARAMETER ancre    AS   CHARACTER        NO-UNDO.       
DEF INPUT        PARAMETER nombre   AS   INTEGER          NO-UNDO.       
DEF INPUT        PARAMETER tag      AS   CHARACTER        NO-UNDO.       
DEF INPUT        PARAMETER texte    AS   CHARACTER        NO-UNDO.       
DEF INPUT-OUTPUT PARAMETER ligne    AS   CHARACTER        NO-UNDO.
DEF VAR i          AS   INTEGER                    NO-UNDO.

DO i = 1 TO nombre:
   IF INDEX(tag,ancre + STRING(i,"99")) <> 0 THEN ligne = REPLACE(ligne,tag,ENTRY(i,texte,"#")).
END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

